home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr48
/
ned100.zip
/
NEDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-04-08
|
76KB
|
2,305 lines
{ FILE: nedemo.pas }
program EditDemo;
{ -------------------------------------------------------------------- }
{ }
{ }
{ NEDEMO.PAS is loosly based on the Borland TVEDIT program. }
{ Therefore, as with NEWEDIT, all copyrights apply. However, }
{ I've freely "included" code from other CIS BPROGA contributers, }
{ and have made every attempt to give credit where it is due. }
{ }
{ This file contains the driver code for the NEWEDIT unit. The }
{ driver is NOT necessary to use NEWEDIT. You can plug NEWEDIT }
{ into your application or Borland's TVEDIT demo if you like. }
{ Please read the NEWEDIT.DOC file for further information on }
{ how to use NEWEDIT with other programs. }
{ }
{ You should NOT place anything in here that does not have to do }
{ with menus, the status line, the video screen, or the desktop. }
{ }
{ NEDEMO.PAS shows various techniques to modify the screen size, }
{ keep the GADGETS heap view under control when switching screen }
{ sizes, load and store the desktop, modifying the status line to }
{ change when certain keys are pressed, and a quick and dirty method }
{ of setting your own palette colors. }
{ }
{ Each of these techniques is clearly marked by a "label." If you }
{ are interested in a particular technique, search for one of the }
{ labels listed below to see the applicable code. }
{ }
{ Label Description: }
{ ------ ------------ }
{ }
{ COLORS - A quick and dirty method to modify the TV palette. }
{ }
{ DESKTOP - Methods for loading and storing the desktop }
{ automatically. }
{ }
{ MEMWIN - How to keep the memory indicator view positioned properly. }
{ }
{ SCRNSZ - Method for switching between normal and 43/50 lines. }
{ }
{ STATLN - Method for modifying the status line. }
{ }
{ Al Andersen - 02/29/92. }
{ }
{ -------------------------------------------------------------------- }
{$F+,X+,S-,D-}
{$M 16384,8192,655360}
{ -------------------------------------------------------------------------- }
{ }
{ UNITS REQUIRED BY APPLICATION }
{ }
{ -------------------------------------------------------------------------- }
uses
Dos,
Buffers,
Objects,
Drivers,
Memory,
Views,
Menus,
Dialogs,
StdDlg,
MsgBox,
App,
HelpFile,
Gadgets,
CmdFile, { Add CmdFile, EditPkg, NewEdit, and EditHelp. }
EditPkg,
NewEdit;
{ -------------------------------------------------------------------------- }
{ }
{ GLOBAL OBJECT, VARIABLE, CONSTANT DECLARATIONS }
{ }
{ -------------------------------------------------------------------------- }
{ ------------------------------------------------ }
{ }
{ Define object for application called T_EditDemo. }
{ Override and/or add methods to utilize object. }
{ }
{ ------------------------------------------------ }
TYPE
P_EditDemo = ^T_EditDemo;
T_EditDemo = object (App.TApplication)
{ MEMWIN - Start. }
Memory_Indicator : PHeapView;
{ MEMWIN - Stop. } { For heap display on satus line. }
constructor Init;
destructor Done; virtual;
{ DESKTOP - Start. }
procedure DesktopReadViews (VAR S : TStream);
procedure DesktopWriteViews (VAR S : TStream);
{ DESKTOP - Stop. } { Methods to read and write the desktop file. }
{ COLORS - Start. }
function GetPalette : Views.PPalette; virtual;
{ COLORS - Stop. } { Method to replace the current palette with our palette. }
procedure GetEvent (var Event : Drivers.TEvent); virtual;
procedure HandleEvent (var Event : Drivers.TEvent); virtual;
procedure Idle; virtual;
procedure InitMenuBar; virtual;
procedure InitStatusLine; virtual;
{ MEMWIN - Start. }
function Insert_Memory_Indicator : Boolean;
{ MEMWIN - Stop. } { Method to put heap memory view on status line. }
{ DESKTOP - Start. }
function Load_Desktop : Boolean;
{ DESKTOP - Stop. } { Method to read desktop off the disk. }
procedure OutOfMemory; virtual;
{ DESKTOP - Start. }
function Save_Desktop : Boolean;
{ DESKTOP - Stop. } { Method to write the desktop to the disk. }
{ SCRNSZ - Start. }
procedure Toggle_Video_Mode;
{ SCRNSZ - Stop. } { Method to toggle between normal and 43/50 line mode. }
end;
{ --------------------------------------------------------------- }
{ }
{ Define object to display what menu items do on the status line. }
{ }
{ --------------------------------------------------------------- }
{ STATLN - Start. }
P_Status_Line_Help = ^T_Status_Line_Help;
T_Status_Line_Help = object (Menus.TStatusLine)
function Hint (AHelpCtx : Word): String; virtual;
end;
{ STATLN - Stop. } { Object and method to print help on status line. }
{ ----------------------------------------------------- }
{ }
{ I don't even like the default colors, so I'm creating }
{ a brand new, customized application COLOR palette. }
{ The monochrome and black-and-white palettes remain }
{ untouched. }
{ }
{ ----------------------------------------------------- }
CONST
{ COLORS - Start }
New_Colors =
{0 1 2 3 4 5 6 7 8 9}
#$17#$70#$78#$74#$1F#$47#$1E#$17#$1F +
#$1A#$17#$4F#$1E#$71#$00#$37#$3F#$3A#$13 +
#$13#$3E#$21#$00#$70#$7F#$7A#$13#$13#$70 +
#$1F#$00#$70#$7F#$7A#$17#$1F#$70#$70#$7E +
#$74#$60#$6B#$6F#$67#$6E#$70#$30#$3F#$3E +
#$1F#$1B#$1A#$5F#$75#$17#$5F#$30#$2F#$2F +
#$31#$2F#$00#$00;
{ COLORS - Stop } { Custom application palatte. }
{ ------------------------------------------ }
{ }
{ Define any other global constants we need. }
{ }
{ ------------------------------------------ }
CONST { Command constants. }
{ DESKTOP - Start. }
Desktop_Name : string = 'NEDEMO.DSK';
{ DESKTOP - Stop. } { Default name for the desktop disk file. }
{ SCRNSZ - Start. }
Current_Screen_Mode : Word = Drivers.ScreenMode;
{ SCRNSZ - Stop. } { Desktop variable to keep track of current screen mode. }
Application_Name = 'NEDEMO'; { Application filename required for help. }
{ -------------------------------------------------------------------------- }
{ }
{ PROCEDURES AND FUNCTIONS }
{ }
{ -------------------------------------------------------------------------- }
{ STATLN - Start. }
procedure Change_Status_Line;
{ -------------------------------------------------- }
{ }
{ This procedure changes the state of the status bar }
{ when the user presses Shift, Alt, and Ctrl keys. }
{ }
{ Note the following values: }
{ }
{ $80 - Ins Active }
{ $40 - Caps Lock Active }
{ $20 - Num Lock Active }
{ $10 - Scroll Lock Active }
{ $08 - Alt Depressed }
{ $04 - Ctrl Depressed }
{ $02 - Left Shift Depressed }
{ $01 - Right Shift Depressed }
{ }
{ -------------------------------------------------- }
procedure Set_Context;
VAR
KbdWord : Word absolute $0040:$0017; { Memory location of scancode. }
begin
if KbdWord and $01 <> 0 then
Desktop^.HelpCtx := CmdFile.hckbShift else { RightShift }
if KbdWord and $02 <> 0 then
Desktop^.HelpCtx := CmdFile.hckbShift else { LeftShift }
if KbdWord and $04 <> 0 then
Desktop^.HelpCtx := CmdFile.hckbCtrl else { Ctrl }
if KbdWord and $08 <> 0 then
Desktop^.HelpCtx := CmdFile.hckbAlt else { Alt }
Desktop^.HelpCtx := Views.hcNoContext;
end; { Set_Context }
begin { Change_Status_Line }
case Desktop^.HelpCtx of
Views.hcNoContext,
CmdFile.hckbShift,
CmdFile.hckbAlt,
CmdFile.hckbCtrl : Set_Context;
end;
end; { Change_Status_Line }
{ STATLN - Stop. } { Procedure responsible placing Shift, Alt, Ctrl stats. }
{ -------------------------------------------------------------------------- }
function ExecDialog (P : PDialog; Data : Pointer) : Word;
{ ------------------------------------------------------------- }
{ }
{ This function handles any dialog box requests you might have. }
{ }
{ ------------------------------------------------------------- }
VAR
Result : Word; { Holds result of last dialog box event. }
begin
ExecDialog := Views.cmCancel;
Result := Views.cmCancel;
P := PDialog (App.Application^.ValidView (P));
{ ------------------------------------------------ }
{ }
{ If we can't find the dialog box code (programmer }
{ forgot it) tell the user that it is missing. }
{ }
{ ------------------------------------------------ }
if P = nil then
begin
MsgBox.MessageBox (^C'Dialog is missing!', nil,
MsgBox.mfError + MsgBox.mfOkButton);
Exit;
end;
{ --------------------------------------------------------- }
{ }
{ If you have a data record for the dialog box, pass it }
{ to the dialog. Put the dialog on the desktop and store }
{ the last event result. If the result indicates the user }
{ did NOT cancel the dialog AND the user entered data, }
{ get the data back from the dialog so the caller has }
{ access to it. }
{ }
{ --------------------------------------------------------- }
if Data <> nil then
P^.SetData (Data^);
Result := DeskTop^.ExecView (P);
if (Result <> cmCancel) and (Data <> nil) then
P^.GetData (Data^);
{ -------------------------------------------------------------- }
{ }
{ Dispose of the dialog and return the last event to the caller. }
{ }
{ -------------------------------------------------------------- }
Dispose (P, Done);
ExecDialog := Result;
end; { ExecDialog }
{ -------------------------------------------------------------------------- }
{ STATLN - Start. }
function T_Status_Line_Help.Hint (AHelpCtx : Word): String;
{ -------------------------------------------- }
{ }
{ This function puts a hint on the status line }
{ as to what a menu option is supposed to do. }
{ Hints are arranged in order by menu. }
{ }
{ -------------------------------------------- }
begin
case AHelpCtx of
CmdFile.hcFile_Menu : Hint := 'This menu contains file and DOS features.';
CmdFile.hcOpen : Hint := 'Open a file for editing.';
CmdFile.hcNew : Hint := 'Create a new file for editing.';
CmdFile.hcSave : Hint := 'Save current file and continue editing.';
CmdFile.hcSaveDone : Hint := 'Save current file and close window.';
CmdFile.hcSaveAs : Hint := 'Save current file to a different file name.';
CmdFile.hcChangeDir : Hint := 'Change to another directory.';
CmdFile.hcShellToDos : Hint := 'Drop into MS-DOS command shell.';
CmdFile.hcExit : Hint := 'Exit application and return to MS-DOS.';
CmdFile.hcEdit_Menu : Hint := 'This menu contains cut and paste features.';
CmdFile.hcUndo : Hint := 'Undo last non-wordwrap operation.';
CmdFile.hcCopy : Hint := 'Copy selected text into clipboard.';
CmdFile.hcCut : Hint := 'Delete selected text and put into clipboard.';
CmdFile.hcPaste : Hint := 'Paste clipboard contents into document.';
CmdFile.hcClipboard : Hint := 'View the contents of the clipboard.';
CmdFile.hcClear : Hint := 'Delete selected text, do NOT put in clipboard.';
CmdFile.hcSearch_Menu : Hint := 'This menu contains find and replace features.';
CmdFile.hcFind : Hint := 'Find particular text.';
CmdFile.hcReplace : Hint := 'Find text and replace it with new text.';
CmdFile.hcAgain : Hint := 'Repeat last FIND or SEARCH operation.';
CmdFile.hcWindows_Menu : Hint := 'This menu contains windowing features.';
CmdFile.hcResize : Hint := 'Change current window size and/or position.';
CmdFile.hcZoom : Hint := 'Toggle current window to full/normal size.';
CmdFile.hcNext : Hint := 'Go to next window.';
CmdFIle.hcPrev : Hint := 'Go to previous window.';
CmdFile.hcClose : Hint := 'Close current window.';
CmdFile.hcTile : Hint := 'Arrange desktop windows into tile pattern.';
CmdFile.hcCascade : Hint := 'Arrange desktop windows into cascade pattern.';
CmdFile.hcDesktop_Menu : Hint := 'This menu contains editor/program options.';
CmdFile.hcLoadDesktop : Hint := 'Load contents of previous desktop.';
CmdFile.hcSaveDesktop : Hint := 'Save contents of current desktop.';
CmdFile.hcToggleVideo : Hint := ' Toggle between 25 and 43/50 line screen.';
CmdFile.hckbAlt : Hint := '[ALT] KEY';
CmdFile.hckbCtrl : Hint := '[CTRL] KEY';
CmdFile.hckbShift : Hint := '[SHIFT] KEY';
Views.hcDragging : Hint := 'RESIZE VIEW';
$FFFF : Hint := 'HELP MODE';
else
Hint := '';
end;
end; { T_Status_Line.Hint }
{ STATLN - Stop. } { Function responsible for putting menu help on status line. }
{ -------------------------------------------------------------------------- }
constructor T_EditDemo.Init;
{ --------------------------------------------------------------------- }
{ }
{ This constructor registers all associated TPU's, initializes buffers, }
{ and sets up any unique processes for the application. }
{ }
{ --------------------------------------------------------------------- }
CONST
{ COLORS - Start. }
P : array[App.apColor..App.apMonochrome] of string[Length (New_Colors)] =
(App.CColor, App.CBlackWhite, App.CMonochrome);
{ COLORS - Stop. } { Pointer to array that holds application color palette. }
VAR
Counter : Integer; { General purpose index counter. }
Event : Drivers.TEvent; { Object to push onto event queue. }
File_Name : DOS.PathStr; { String to hold default file name. }
begin
{ ---------------------------------------------- }
{ }
{ System.File mode controls open but not create. }
{ Do a fixup so networks don't run into hassles. }
{ }
{ ---------------------------------------------- }
if Lo (DosVersion) >= 3 then
System.FileMode := $20 { OPEN Read_Only + Deny_Write }
else
System.FileMode := $0; { ATTR: Read_Only }
{ ---------------------------------------- }
{ }
{ Allocate a buffer for use by the editor. }
{ Call ancestor Init constructor and then }
{ register all required object streams. }
{ }
{ ---------------------------------------- }
EditPkg.Initialize_The_Editor;
App.TApplication.Init;
Objects.RegisterObjects;
Views.RegisterViews;
Menus.RegisterMenus;
Dialogs.RegisterDialogs;
App.RegisterApp;
Helpfile.RegisterHelpFile;
NewEdit.RegisterEditors;
{ ------------------------------------------------- }
{ }
{ The GADGETS heap view is a handy little critter, }
{ especially for ensuring we allocate/deallocate }
{ objects correctly. So I included it. Initialize }
{ it, and load a previous desktop, if any. }
{ }
{ ------------------------------------------------- }
{ MEMWIN - Start. }
{ DESKTOP - Start. }
Insert_Memory_Indicator;
Load_Desktop;
{ DESKTOP - Stop. } { Load previous desktop, if any. }
{ MEMWIN - Stop. } { Insert heap view window on status line. }
{ ---------------------------------------------- }
{ }
{ Disable commands that are of no immediate use. }
{ Note that not all of these are necessary, for }
{ you can change the menus to suit your tastes. }
{ I have commented out all those not used here. }
{ }
{ ---------------------------------------------- }
DisableCommands ([NewEdit.cmFind,
NewEdit.cmReplace,
NewEdit.cmSave,
NewEdit.cmSaveAs,
NewEdit.cmSaveDone,
NewEdit.cmSearchAgain,
Views.cmCascade,
Views.cmClear,
Views.cmCopy,
Views.cmCut,
Views.cmPaste,
Views.cmTile,
Views.cmUndo]);
{ NewEdit.cmCenterText, }
{ NewEdit.cmIndentMode, }
{ NewEdit.cmJumpLine, }
{ NewEdit.cmJumpMark1, }
{ NewEdit.cmJumpMark1, }
{ NewEdit.cmJumpMark2, }
{ NewEdit.cmJumpMark3, }
{ NewEdit.cmJumpMark4, }
{ NewEdit.cmJumpMark5, }
{ NewEdit.cmJumpMark6, }
{ NewEdit.cmJumpMark7, }
{ NewEdit.cmJumpMark8, }
{ NewEdit.cmJumpMark9, }
{ NewEdit.cmJumpMark0, }
{ NewEdit.cmReformDoc, }
{ NewEdit.cmReformPara, }
{ NewEdit.cmRightMargin, }
{ NewEdit.cmSetMark1, }
{ NewEdit.cmSetMark1, }
{ NewEdit.cmSetMark2, }
{ NewEdit.cmSetMark3, }
{ NewEdit.cmSetMark4, }
{ NewEdit.cmSetMark5, }
{ NewEdit.cmSetMark6, }
{ NewEdit.cmSetMark7, }
{ NewEdit.cmSetMark8, }
{ NewEdit.cmSetMark9, }
{ NewEdit.cmSetMark0, }
{ NewEdit.cmSetTabs, }
{ NewEdit.cmWordWrap]); }
{ ---------------------------------------- }
{ }
{ We need to disable the 43/50 column mode }
{ if the video card doesn't support it. }
{ }
{ ---------------------------------------- }
{ SCRNSZ - Start. }
if Drivers.HiresScreen = False then
DisableCommands ([CmdFile.cmToggleVideo]);
{ SCRNSZ - Stop. }
{ ------------------------------------------------- }
{ }
{ Call the EDITPKG unit to intialize the clipboard. }
{ }
{ ------------------------------------------------- }
EditPkg.Initialize_The_Clipboard;
{ -------------------------------------------------------- }
{ }
{ We allow the user to pass a file name parameter from DOS }
{ when running the program. If a parameter was passed in }
{ call the editor to open an edit window for the file. }
{ }
{ -------------------------------------------------------- }
for Counter := 1 to ParamCount do
if (pos ('*', ParamStr (Counter)) = 0) and (pos ('?', ParamStr (Counter)) = 0) then
EditPkg.Open_Editor (ParamStr (Counter), TRUE);
{ ------------------------------------------------------------ }
{ }
{ The desktop is ready, so now a brief word from your sponsor. }
{ Push cmAbout event on the event queue so the About box }
{ will appear when we first run the application. }
{ }
{ ------------------------------------------------------------ }
Event.What := Drivers.evCommand;
Event.command := CmdFile.cmAbout;
PutEvent (Event);
end; { T_EditDemo.Init }
{ -------------------------------------------------------------------------- }
destructor T_EditDemo.Done;
{ --------------------------------------------------------------------- }
{ }
{ This destructor deallocates any unique processes for the application. }
{ Currently it saves the current desktop, calls the ancestor done }
{ method, and then deallocates any buffers set up by the editor. }
{ }
{ --------------------------------------------------------------------- }
begin
Save_Desktop;
App.TApplication.Done;
EditPkg.Deallocate_The_Editor;
end; { T_EditDemo.Done }
{ -------------------------------------------------------------------------- }
{ DESKTOP - Start. }
procedure T_EditDemo.DesktopReadViews (VAR S : TStream);
{ ------------------------------------------- }
{ }
{ This procedure closes all desktop views }
{ and then reads in each view from a previous }
{ desktop, putting it on the current desktop. }
{ }
{ ------------------------------------------- }
VAR
P : Views.PView; { Pointer to each of the desktop views. }
{ -------------------------------------------------------------------------- }
procedure Command_All (Command_Constant : Word );
procedure Action (P : Views.PView); far;
begin
Message (P, evCommand, Command_Constant, nil);
end; { Action }
begin { Command_All }
Desktop^.ForEach (@Action);
end; { Command_All }
{ -------------------------------------------------------------------------- }
procedure Close_All_Views;
begin
Command_All (cmClose);
end; { Close_All_Views }
{ -------------------------------------------------------------------------- }
begin { DesktopReadViews }
{ ----------------------------------------------------- }
{ }
{ If we don't have a valid desktop, forget it and exit. }
{ Otherwise, close all current views on the desktop. }
{ }
{ ----------------------------------------------------- }
if not Desktop^.Valid (Views.cmClose) then
Exit;
Close_All_Views;
{ -------------------------------------------------------- }
{ }
{ The first item in any previous desktop that was saved is }
{ the Current_Screen_Mode. Get it and determine if it was }
{ 43/50 line mode. If so, toggle the screen to that mode. }
{ }
{ -------------------------------------------------------- }
S.Read (Current_Screen_Mode, SizeOf (Current_Screen_Mode));
if (Current_Screen_Mode AND Drivers.smFont8x8 = Drivers.smFont8x8) then
Toggle_Video_Mode;
{ ----------------------------------------------- }
{ }
{ Now read in each view from the previous desktop }
{ and insert it on our desktop. Exit when there }
{ are no more views to read in. }
{ }
{ ----------------------------------------------- }
while True do
begin
P := Views.PView (S.Get);
Desktop^.InsertBefore (App.Application^.ValidView (P), Desktop^.Last);
if P = nil then
Exit;
end;
end; { T_EditDemo.DesktopReadViews }
{ DESKTOP - Stop. } { Procedure responsible for actually reading desktop file. }
{ -------------------------------------------------------------------------- }
{ DESKTOP - Start. }
procedure T_EditDemo.DesktopWriteViews (VAR S : TStream);
{ ----------------------------------------------- }
{ }
{ This procedure writes all current desktop views }
{ and and the Current_Video_Mode to the disk. }
{ }
{ ----------------------------------------------- }
VAR
P : Views.PView; { Pointer to each of the desktop views. }
{ -------------------------------------------------------------------------- }
procedure WriteView (P : PView); far;
{ ----------------------------------------------------------- }
{ }
{ A local procedure that actually puts all the views to disk. }
{ }
{ ----------------------------------------------------------- }
begin
if P <> Desktop^.Last then
S.Put (P);
end; { WriteView }
{ -------------------------------------------------------------------------- }
begin { DesktopWriteViews }
{ ----------------------------------------------------------------------- }
{ }
{ First write the Current_Video_Mode to disk, and then each desktop view. }
{ }
{ ----------------------------------------------------------------------- }
S.Write (Current_Screen_Mode, SizeOf (Current_Screen_Mode));
Desktop^.ForEach (@WriteView);
S.Put (nil);
end; { T_EditDemo.DesktopWriteViews }
{ DESKTOP - Stop. } { Procedure responsible for actually writing desktop file. }
{ ------------------------------------------------------------------------ }
procedure T_EditDemo.GetEvent (var Event : Drivers.TEvent);
{ ---------------------------------------- }
{ }
{ This procedure intercepts system events, }
{ constantly looking to see if help has }
{ been requested. }
{ }
{ ---------------------------------------- }
VAR
File_Mode : Word; { Used for networking access. }
Help_Stream : Objects.PDosStream; { DOS stream to place help file on. }
Help_File : HelpFile.PHelpFile; { Name of the help file. }
W : Views.PWindow; { Help file window. }
CONST
Help_In_Use : Boolean = False; { Prevents user from opening more than 1 help file. }
{ -------------------------------------------------------------------------- }
function Calc_Help_Name : DOS.PathStr;
{ ------------------------------------------------ }
{ }
{ This function calculates what the help file name }
{ is, based on the application name being run. }
{ }
{ ------------------------------------------------ }
VAR
Directory : DOS.DirStr; { Home directory of the application. }
EXE_File : DOS.PathStr; { Name of the EDITDEMO.EXE file. }
File_Extension : DOS.ExtStr; { The file name extension. }
File_Name : DOS.NameStr; { The file name minus the extension. }
begin
{ -------------------------------------------------------- }
{ }
{ Check for the DOS version. If it is >= 3 the file name }
{ is in parameter #0 of the arguments passed into program. }
{ Otherwise, we have to search for the file in the PATH. }
{ }
{ -------------------------------------------------------- }
if Lo (DOS.DosVersion) >= 3 then
EXE_File := ParamStr (0)
else
EXE_File := DOS.FSearch (Application_Name, GetEnv ('PATH'));
{ ---------------------------------------------- }
{ }
{ Split the File_Name into its component parts. }
{ Search for the help file in current directory. }
{ }
{ ---------------------------------------------- }
DOS.FSplit (EXE_File, Directory, File_Name, File_Extension);
if Directory[Length (Directory)] = '\' then
Dec (Directory[0]);
Calc_Help_Name := DOS.FSearch (Application_Name + '.HLP', Directory);
end; { Calc_Help_Name }
{ -------------------------------------------------------------------------- }
begin { GetEvent }
{ -------------------------------------------------------------- }
{ }
{ Get the event and see if 1) it is for help and 2) help is NOT }
{ being used. If true, then allocate a stream and put the help }
{ file on it. Then test if stream opened OK. If not, tell user }
{ couldn't open the help file. Otherwise, open a help view. }
{ Clear the event and set Help_In_Use to FALSE before exiting. }
{ }
{ -------------------------------------------------------------- }
App.TApplication.GetEvent (Event);
case Event.What of
evCommand:
if (Event.Command = Views.cmHelp) and not Help_In_Use then
begin
{ ----------------------------------------------------- }
{ }
{ Help requested. Disallow use of multiple help files. }
{ }
{ ----------------------------------------------------- }
Help_In_Use := True;
{ ----------------------------------------- }
{ }
{ Set File_Mode to default to read only. }
{ If MS-DOS is 3 or better set to read only }
{ and deny write privleges. }
{ }
{ ----------------------------------------- }
File_Mode := Objects.stOpenRead;
if Lo (DosVersion) >= 3 then
File_Mode := $3d20;
{ -------------------------------------------------------- }
{ }
{ Calculate help file name based on the applications name. }
{ }
{ -------------------------------------------------------- }
Help_Stream := New (Objects.PDosStream, Init (Calc_Help_Name, File_Mode));
Help_File := New (HelpFile.PHelpFile, Init (Help_Stream));
{ ------------------------------------------------------------------- }
{ }
{ Let the user know if there was a problem opening/finding help file. }
{ }
{ ------------------------------------------------------------------- }
if Help_Stream^.Status <> Objects.stOk then
begin
MsgBox.MessageBox (^C'Could not open help file.',
nil, MsgBox.mfError + MsgBox.mfOkButton);
Dispose (Help_File, Done);
end
else
begin
{ --------------------------------------------------- }
{ }
{ Allocate the help view. If we've got enough memory }
{ attach the help view to the desktop. Dispose the }
{ view when we are done, and clear the event. }
{ }
{ --------------------------------------------------- }
W := New (HelpFile.PHelpWindow, Init (Help_File, GetHelpCtx));
if ValidView (W) <> nil then
begin
W^.HelpCtx := $FFFF;
ExecView (W);
Dispose (W, Done);
end;
ClearEvent (Event);
end;
{ --------------------------------------------------------------- }
{ }
{ Signal that a help window can is allowed to be be opened again. }
{ }
{ --------------------------------------------------------------- }
Help_In_Use := False;
end;
Drivers.evMouseDown:
if Event.Buttons <> 1 then
Event.What := Drivers.evNothing;
end;
end; { T_EditDemo.GetEvent }
{ -------------------------------------------------------------------------- }
{ COLORS - Start. }
function T_EditDemo.GetPalette : Views.PPalette;
{ --------------------------------------------- }
{ }
{ This is an oveload method on TApplication. }
{ We simply reset the application COLOR palette }
{ with our New_Colors. }
{ }
{ --------------------------------------------- }
CONST
CNewBlackWhite = App.CBlackWhite + HelpFile.CHelpBlackWhite;
CNewColor = New_Colors + HelpFile.CHelpColor;
CNewMonochrome = App.CMonochrome + HelpFile.CHelpMonochrome;
P : array[App.apColor..App.apMonochrome] of string[Length (CNewColor)] = (CNewColor,
CNewBlackWhite,
CNewMonochrome);
begin
GetPalette := @P[AppPalette];
end; { T_EditDemo.GetPalette }
{ COLORS - Stop. } { Required to replace current palatte with our New_Colors. }
{ -------------------------------------------------------------------------- }
procedure T_EditDemo.HandleEvent (var Event : TEvent);
{ ----------------------------------------------- }
{ }
{ This procedure handles all the system events. }
{ If at all possible, try to keep event handlers }
{ local to this procedure, in alphabetical order. }
{ }
{ ----------------------------------------------- }
{ ------------------------------------------------------------------------ }
procedure About_Dialog;
{ -------------------------------------------------------------- }
{ }
{ This procedure simply brings the "About The Program" dialog }
{ up for the user to see. It's only used once so I put it here. }
{ You can change the text to anything you want. Remember that }
{ there is a 128 character limitation on static text! }
{ }
{ -------------------------------------------------------------- }
VAR
D : Dialogs.PDialog; { The Dialog box. }
R : TRect; { The bounds of the box. }
begin
{ ------------------------------------------------------------ }
{ }
{ Assign the bounds of the box, then insert the label into it. }
{ Now shrink it so we are inside of frame., Insert some text }
{ that is centered into it, then assign an OK button. }
{ }
{ ------------------------------------------------------------ }
R.Assign (0, 0, 50, 20);
D := New (Dialogs.PDialog, Init (R, 'About The Program'));
with D^ do
begin
Options := Options or Views.ofCentered;
D^.HelpCtx := CmdFile.hcDAbout;
R.Grow (-1, -1);
Dec (R.B.Y, 3);
Insert (New (Dialogs.PStaticText, Init (R, + #13 +
^C'NewEdit v1.00 Demonstration Program' + #13 + #13 +
^C'Author: Al Andersen' + #13 +
^C'PO Box 2436' + #13 +
^C'Sierra Vista, AZ 85636' + #13 + #13 +
^C'CIS ID: 71610,3214' + #13 +
^C'Internet: aandersen@huachuca-emh2.army.mil' + #13 + #13 +
^C'Special Thanks To:' + #13 + #13 +
^C'Johnathan Stein and Tom Campbell' + #13 +
^C'for their unwavering support.')));
R.Assign (20, 17, 30, 19);
Insert (New (Dialogs.PButton, Init (R, 'O~K~', Views.cmOk, Dialogs.bfDefault)));
end;
{ ------------------------------------------------------------------- }
{ }
{ Test to see if the view is valid, and if so, put it on the desktop. }
{ Oh yeah, don't forget to dispose of the view! }
{ }
{ ------------------------------------------------------------------- }
if ValidView (D) <> nil then
ExecDialog (D, nil);
end; { About_Dialog }
{ ------------------------------------------------------------------------ }
procedure Cascade;
{ --------------------------------------------------- }
{ }
{ This procedure gets the extent of the desktop and }
{ then puts open windows into a "cascade" pattern. }
{ }
{ --------------------------------------------------- }
VAR
R : TRect; { Bounds of the desktop. }
begin
Desktop^.GetExtent (R);
Desktop^.Cascade (R);
end; { Cascade }
{ ------------------------------------------------------------------------ }
procedure Change_Directory;
{ --------------------------------------------------------------- }
{ }
{ This procedure brings up a "tree" dialog to change directories. }
{ }
{ --------------------------------------------------------------- }
VAR
D : Dialogs.PDialog;
begin
D := New (StdDlg.PChDirDialog, Init (StdDlg.cdNormal, 0));
D^.HelpCtx := CmdFile.hcDDirName;
ExecDialog (D, nil);
end; { Change_Directory }
{ ------------------------------------------------------------------------ }
procedure Quit_Program;
{ ------------------------------------------ }
{ }
{ This procedure calls EndModal to close all }
{ views before terminating the application. }
{ Yeah, I know, but its the way I do things! }
{ }
{ ------------------------------------------ }
begin
TView.EndModal (cmQuit);
end; { Quit_Program}
{ ------------------------------------------------------------------------ }
procedure Shell_To_DOS;
{ --------------------------------------------------- }
{ }
{ This procedure does the necessary memory management }
{ to allow the user to shell to MS-DOS and reenter }
{ the program again. }
{ }
{ --------------------------------------------------- }
{ ---------------------------------------------------------------------- }
function Buffers_In_Use : Boolean;
{ ------------------------------------------------------------ }
{ }
{ This is a local procedure that determins the buffers in use. }
{ It's required to determine where to SetMemTop before/after }
{ shelling to MS-DOS. }
{ }
{ ------------------------------------------------------------ }
begin
Buffers_In_Use := (PtrRec (HeapEnd).Seg <> BufHeapEnd) and (BufHeapEnd <> 0);
end; { Buffers_In_Use }
{ ---------------------------------------------------------------------- }
begin { Shell_To_Dos }
{ ------------------------------------------- }
{ }
{ If we've got a good desktop we need to do }
{ some house cleaning before we go to MS-DOS. }
{ }
{ ------------------------------------------- }
if Desktop <> nil then
begin
Drivers.DoneSysError;
Drivers.DoneEvents;
Drivers.DoneVideo;
Memory.DoneMemory;
end;
{ ----------------------------------------------- }
{ }
{ Now see if we've allocated any special buffers, }
{ i.e. the editor, and SetMemTop accordingly. }
{ }
{ ----------------------------------------------- }
if Buffers_In_Use then
SetMemTop (Ptr (BufHeapPtr, 0))
else
SetMemTop (HeapPtr);
{ ------------------------------------ }
{ }
{ Always tell the user what's required }
{ to get back into the application. }
{ Then go to MS-DOS. Reverse all that }
{ we did to bet back into the program. }
{ }
{ ------------------------------------ }
PrintStr ('Type ''EXIT'' to return...');
SwapVectors;
DOS.Exec (GetEnv ('COMSPEC'), '');
SwapVectors;
if Buffers_In_Use then
SetMemTop (Ptr (BufHeapEnd, 0))
else
SetMemTop ( HeapEnd);
if Desktop <> nil then
begin
Memory.InitMemory;
Drivers.InitVideo;
Drivers.InitEvents;
Drivers.InitSysError;
App.Application^.Redraw;
end;
{ ---------------------------------------- }
{ }
{ If all went well, exit this procedure. }
{ Otherwise, tell user there is a problem. }
{ }
{ ---------------------------------------- }
if DosError = 0 then
Exit;
MsgBox.MessageBox (^C'DOS Reports an error!', nil,
MsgBox.mfInformation + MsgBox.mfOKbutton);
end; { Shell_To_DOS }
{ ------------------------------------------------------------------------ }
procedure Tile;
{ ------------------------------------------------- }
{ }
{ This procedure gets the extent of the desktop and }
{ then puts all open windows into a "tile pattern." }
{ }
{ ------------------------------------------------- }
VAR
R : TRect; { Bounds of the desktop. }
begin
Desktop^.GetExtent (R);
Desktop^.Tile (R);
end; { Tile }
{ -------------------------------------------------------------------------}
{ -------------------------------------- }
{ }
{ Main body of T_EditDemo.HandleEvent. }
{ All commands are dispatched from here. }
{ }
{ -------------------------------------- }
begin
App.TApplication.HandleEvent (Event);
case Event.What of evCommand:
begin
case Event.Command of
CmdFile.cmAbout : About_Dialog;
CmdFile.cmChangeDir : Change_Directory;
CmdFile.cmClipboard : EditPkg.Show_ClipBoard;
{ DESKTOP - Start. }
CmdFile.cmLoadDesktop : Load_Desktop;
{ DESKTOP - Stop. }
CmdFile.cmNew : EditPkg.Open_Editor ('', True);
CmdFile.cmOpen : EditPkg.Run_The_Editor;
{ DESKTOP - Start. }
CmdFile.cmSaveDesktop : Save_Desktop;
{ DESKTOP - Stop. }
CmdFile.cmShellToDos : Shell_To_DOS;
{ SCRNSZ - Start. }
CmdFile.cmToggleVideo : Toggle_Video_Mode;
{ SCRNSZ - Stop. }
Views.cmCascade : Cascade;
Views.cmQuit : Quit_Program;
Views.cmTile : Tile;
else
Exit;
end;
ClearEvent (Event);
end;
end;
end; { TApplication.HandleEvent }
{ ---------------------------------------------------------------------------}
procedure T_EditDemo.Idle;
{ ---------------------------------------------------------- }
{ }
{ This function handles events during system idle time. }
{ Specifically, toggling on off of menu options that need }
{ changing, updating the memory indicator view, and changing }
{ the status line if Shift, Alt, or Ctrl keys are pressed. }
{ }
{ ---------------------------------------------------------- }
{ ------------------------------------------------------------------------ }
function Is_Tileable (P : Views.PView) : Boolean; far;
{ ------------------------------------------ }
{ }
{ This is a local function that tests to see }
{ if views can be tiled and/or cascaded. }
{ }
{ ------------------------------------------ }
begin
Is_Tileable := P^.Options and Views.ofTileable <> 0;
end;
begin { T_EditDemo.Idle }
{ ------------------------------------------------ }
{ }
{ We don't have anything real special to do here, }
{ so call ancestor Idle method first. Then update }
{ the Memory_Indicator view and check to see if }
{ the status line needs to be changed. }
{ }
{ ------------------------------------------------ }
App.TApplication.Idle;
{ MEMWIN - Start. }
{ STATLN - Start. }
Memory_Indicator^.Update;
Change_Status_Line;
{ STATLN - Stop. } { Constantly check if we need to update status line. }
{ MEMWIN - Stop. } { Constantly update heap view window to reflect memory. }
{ ----------------------------------------------------- }
{ }
{ Check to see if first window in desktop can be tiled. }
{ If it can, then we can toggle the cascade/tile and }
{ Next/Prev on. Once the window disappears, disable }
{ the cascade/tile and Next/Prev options. }
{ }
{ ----------------------------------------------------- }
if Desktop^.FirstThat (@Is_Tileable) <> nil then
EnableCommands ([Views.cmTile,
Views.cmCascade,
Views.cmNext,
Views.cmPrev])
else
DisableCommands ([Views.cmTile,
Views.cmCascade,
Views.cmNext,
Views.cmPrev]);
end; { T_EditDemo.Idle }
{ ---------------------------------------------------------------------------}
procedure T_EditDemo.InitMenuBar;
{ --------------------------------------------------------------- }
{ }
{ This procedure sets up the menu bar and all its pulldown menus. }
{ }
{ --------------------------------------------------------------- }
VAR
R : TRect; { Bounds of the desktop. }
begin
{ --------------------------------------------------- }
{ }
{ Get the extent of the desktop and drop top line +1. }
{ }
{ --------------------------------------------------- }
GetExtent (R);
R.B.Y := R.A.Y + 1;
{ --------------------------------------------------------------------- }
{ }
{ This is the MenuBar initialization. Note that it consists }
{ of submenus. The format for declaring a NewItem in a submenu }
{ consists of the following: }
{ }
{ Name - a string, surrounding select characters with tilde's. }
{ Keys - a string indicating which key is a "hot key" for item. }
{ Key Command - TurboVision "kb????" command to bind as hot key. }
{ Item Command - TurboVision "cm????" command to bind to item. }
{ Help Context - TurboVision help context command to bind to item. }
{ }
{ --------------------------------------------------------------------- }
MenuBar := New (Menus.PMenuBar, Init (R, NewMenu (
{ ---------------------------------------- }
{ }
{ This is the FILE submenu initialization. }
{ }
{ ---------------------------------------- }
NewSubMenu ('~F~ile', CmdFile.hcFile_Menu, NewMenu (
NewItem ('~O~pen', 'F3', Drivers.kbF3, CmdFile.cmOpen, CmdFile.hcOpen,
NewItem ('~N~ew', '', Drivers.kbNoKey, CmdFile.cmNew, CmdFile.hcNew,
NewLine (
NewItem ('Save ~C~ontinue', 'F2', Drivers.kbF2, NewEdit.cmSave, CmdFile.hcSave,
NewItem ('Save ~D~one', '^KD', Drivers.kbNoKey, NewEdit.cmSaveDone, CmdFile.hcSaveDone,
NewItem ('Save ~F~ile', '^KF', Drivers.kbNoKey, NewEdit.cmSaveAs, CmdFile.hcSaveAs,
NewLine (
NewItem ('C~h~ange Dir', '', Drivers.kbNoKey, CmdFile.cmChangeDir, CmdFile.hcChangeDir,
NewItem ('~S~hell To DOS', '', Drivers.kbNoKey, CmdFile.cmShellToDos, CmdFile.hcShellToDos,
NewLine (
NewItem ('~E~xit', 'Alt-X', Drivers.kbAltX, Views.cmQuit, CmdFile.hcExit,
nil)))))))))))),
{ ---------------------------------------- }
{ }
{ This is the EDIT submenu initialization. }
{ }
{ ---------------------------------------- }
NewSubMenu ('~E~dit', CmdFile.hcEdit_Menu, NewMenu (
NewItem ('~U~ndo', '^U', Drivers.kbNoKey, Views.cmUndo, CmdFile.hcUndo,
NewLine (
NewItem ('~C~lipboard', '', Drivers.kbNoKey, CmdFile.cmClipboard, CmdFile.hcClipboard,
NewItem ('C~o~py', 'Ctrl-Ins', Drivers.kbCtrlIns, Views.cmCopy, CmdFile.hcCopy,
NewItem ('Cu~t~', 'Shift-Del', Drivers.kbShiftDel, Views.cmCut, CmdFile.hcCut,
NewItem ('~P~aste', 'Shift-Ins', Drivers.kbShiftIns, Views.cmPaste, CmdFile.hcPaste,
NewLine (
NewItem ('C~l~ear', 'Ctrl-Del', Drivers.kbCtrlDel, Views.cmClear, CmdFile.hcClear,
nil))))))))),
{ ------------------------------------------ }
{ }
{ This is the SEARCH submenu initialization. }
{ }
{ ------------------------------------------ }
NewSubMenu ('~S~earch', CmdFile.hcSearch_Menu, NewMenu (
NewItem ('~F~ind', '^QF', Drivers.kbNoKey, NewEdit.cmFind, CmdFile.hcFind,
NewItem ('~S~earch/Replace', '^QA', Drivers.kbNoKey, NewEdit.cmReplace, CmdFile.hcReplace,
NewLine (
NewItem ('~A~gain', '^L', Drivers.kbNoKey, NewEdit.cmSearchAgain, CmdFile.hcAgain,
nil))))),
{ ----------------------------------------- }
{ }
{ This is the WINDOW submenu initalization. }
{ }
{ ----------------------------------------- }
NewSubMenu ('~W~indows', CmdFile.hcWindows_Menu, NewMenu (
NewItem ('~R~esize/Move', 'Ctrl-F5', Drivers.kbCtrlF5, Views.cmResize, CmdFile.hcResize,
NewItem ('~Z~oom', 'F5', Drivers.kbF5, Views.cmZoom, CmdFile.hcZoom,
NewItem ('~P~revious', 'Shift-F6', Drivers.kbShiftF6, Views.cmPrev, CmdFile.hcPrev,
NewItem ('~N~ext', 'F6', Drivers.kbF6, Views.cmNext, CmdFile.hcNext,
NewItem ('~C~lose', 'Alt-F3', Drivers.kbAltF3, Views.cmClose, CmdFile.hcClose,
NewItem ('~T~ile', '', Drivers.kbNoKey, Views.cmTile, CmdFile.hcTile,
NewItem ('C~a~scade', '', Drivers.kbNoKey, Views.cmCascade, CmdFile.hcCascade,
nil)))))))),
{ ------------------------------------------ }
{ }
{ This is the DESKTOP submenu initalization. }
{ }
{ ------------------------------------------ }
NewSubMenu ('~D~esktop', CmdFile.hcDesktop_Menu, NewMenu (
NewItem ('~L~oad Desktop', '', Drivers.kbNoKey, CmdFile.cmLoadDesktop, CmdFile.hcLoadDesktop,
NewItem ('~S~ave Desktop', '', Drivers.kbNoKey, CmdFile.cmSaveDesktop, CmdFile.hcSaveDesktop,
NewLine (
NewItem ('~4~3/50 Lines', '', Drivers.kbNoKey, CmdFile.cmToggleVideo, CmdFile.hcToggleVideo,
nil))))),
nil))))))));
end; { T_EditDemo.InitMenuBar }
{ ---------------------------------------------------------------------------}
procedure T_EditDemo.InitStatusLine;
{ ------------------------------------------------------- }
{ }
{ This procedure sets up the status line and its options. }
{ }
{ ------------------------------------------------------- }
VAR
R : TRect; { Bounds of the desktop. }
begin
{ --------------------------------------------------------- }
{ }
{ Get the extent of the desktop and pull up bottom line -1. }
{ }
{ --------------------------------------------------------- }
GetExtent (R);
R.A.Y := R.B.Y - 1;
{ ------------------------------------------------------------------------- }
{ }
{ This is the Statusline initialization. }
{ The format for declaring a NewStatusKey in a NewStatusDef is: }
{ }
{ Name and Keys - a string, surrounding key select characters with tilde's. }
{ Key Command - TurboVision "kb????" command to bind as hot key. }
{ Item Command - TurboVision "cm????" commnad to bind to item. }
{ }
{ ------------------------------------------------------------------------- }
StatusLine := New (P_Status_Line_Help, Init (R,
NewStatusDef (Views.hcDragging, Views.hcDragging,
NewStatusKey ('', Drivers.kbF1, Views.cmHelp,
NewStatusKey ('~' + #24 + #25
+ #26 + #27
+ '~:Move,', Drivers.kbNoKey, Views.cmValid,
NewStatusKey ('~Shift-' + #24
+ #25 + #26
+ #27 + '~:Resize,', Drivers.kbNoKey, Views.cmValid,
NewStatusKey ('~Enter~:Done,', Drivers.kbNoKey, Views.cmValid,
NewStatusKey ('~Esc~:Cancel', Drivers.kbNoKey, Views.cmValid,
nil))))),
NewStatusDef (0, CmdFile.hcExtra_Menu,
NewStatusKey ( '~F1~:Help,', Drivers.kbF1, Views.cmHelp,
NewStatusKey ( '~F2~:Save,', Drivers.kbF2, NewEdit.cmSave,
NewStatusKey ( '~F3~:Open,', Drivers.kbF3, CmdFile.cmOpen,
NewStatusKey ( '~F5~:Zoom,', Drivers.kbF5, Views.cmZoom,
NewStatusKey ( '~F6~:Next,', Drivers.kbF6, Views.cmNext,
NewStatusKey ( '~F10~:Menu', Drivers.kbF10, Views.cmMenu,
NewStatusKey ('', Drivers.kbF1, Views.cmHelp,
NewStatusKey ('', Drivers.kbAltF3, Views.cmClose,
NewStatusKey ('', Drivers.kbF5, Views.cmZoom,
NewStatusKey ('', Drivers.kbF6, Views.cmNext,
NewStatusKey ('', Drivers.kbShiftF6, Views.cmPrev,
NewStatusKey ('', Drivers.kbCtrlF5, Views.cmResize,
NewStatusKey ('', Drivers.kbF10, Views.cmMenu,
NewStatusKey ('', Drivers.kbAltX, Views.cmQuit,
nil)))))))))))))),
NewStatusDef (CmdFile.hcExtra_Menu, CmdFile.hcMisc_Commands,
NewStatusKey ('~F1~:Help', Drivers.kbF1, Views.cmHelp,
nil),
NewStatusDef (CmdFile.hckbShift, CmdFile.hckbShift,
NewStatusKey ( '~Del~:Cut,', Drivers.kbShiftDel, Views.cmCut,
NewStatusKey ( '~F6~:Prev,', Drivers.kbShiftF6, Views.cmPrev,
NewStatusKey ('~Ins~:Paste', Drivers.kbShiftIns, Views.cmPaste,
nil))),
NewStatusDef (CmdFile.hckbCtrl, CmdFile.hckbCtrl,
NewStatusKey ('~B~:Reformat,', Drivers.kbNoKey, NewEdit.cmReformPara,
NewStatusKey ( '~Del~:Clear,', Drivers.kbCtrlDel, Views.cmClear,
NewStatusKey ( '~F5~:Resize,', Drivers.kbCtrlF5, Views.cmResize,
NewStatusKey ( '~Ins~:Copy,', Drivers.kbCtrlIns, Views.cmCopy,
NewStatusKey ( '~U~:Undo', Drivers.kbNoKey, Views.cmUndo,
nil))))),
NewStatusDef (CmdFile.hckbAlt, CmdFile.hckbAlt,
NewStatusKey ('~F3~:Close,', Drivers.kbAltF3, Views.cmClose,
NewStatusKey ( '~X~:Exit', Drivers.kbAltX, Views.cmQuit,
nil)),
NewStatusDef (CmdFile.hcEditor_Commands, $FFFE,
NewStatusKey ( '~F1~:Help,', Drivers.kbF1, Views.cmHelp,
NewStatusKey ( '~F2~:Save,', Drivers.kbF2, NewEdit.cmSave,
NewStatusKey ( '~F3~:Open,', Drivers.kbF3, CmdFile.cmOpen,
NewStatusKey ( '~F5~:Zoom,', Drivers.kbF5, Views.cmZoom,
NewStatusKey ( '~F6~:Next,', Drivers.kbF6, Views.cmNext,
NewStatusKey ( '~F10~:Menu', Drivers.kbF10, Views.cmMenu,
NewStatusKey ('', Drivers.kbF1, Views.cmHelp,
NewStatusKey ('', Drivers.kbAltF3, Views.cmClose,
NewStatusKey ('', Drivers.kbF5, Views.cmZoom,
NewStatusKey ('', Drivers.kbF6, Views.cmNext,
NewStatusKey ('', Drivers.kbShiftF6, Views.cmPrev,
NewStatusKey ('', Drivers.kbCtrlF5, Views.cmResize,
NewStatusKey ('', Drivers.kbF10, Views.cmMenu,
NewStatusKey ('', Drivers.kbAltX, Views.cmQuit,
nil)))))))))))))),
NewStatusDef ($FFFF, $FFFF,
NewStatusKey ('~Enter~:Select,', Drivers.kbNoKey, Views.cmValid,
NewStatusKey ('~Esc~:Exit,', Drivers.kbEsc, Views.cmClose,
NewStatusKey ('~F5~:Zoom,', Drivers.kbF5, Views.cmZoom,
NewStatusKey ('~Shift-Tab~:Prev,', Drivers.kbNoKey, Views.cmValid,
NewStatusKey ('~Tab~:Next', Drivers.kbNoKey, Views.cmValid,
NewStatusKey ('', Drivers.kbAltF3, Views.cmClose,
NewStatusKey ('', Drivers.kbF5, Views.cmZoom,
NewStatusKey ('', Drivers.kbCtrlF5, Views.cmResize,
nil)))))))),
nil))))))))));
end; { T_EditDemo.InitStatusLine }
{ ---------------------------------------------------------------------------}
{ MEMWIN - Start. }
function T_EditDemo.Insert_Memory_Indicator : Boolean;
{ -------------------------------------------------------------------- }
{ }
{ This function installs the memory indicator view on the status line. }
{ A separate function was required because we need to dispose of it }
{ and re-insert it whenever we toggle screen modes. }
{ }
{ -------------------------------------------------------------------- }
VAR
R : TRect; { Object to show rectangle bounds. }
begin
GetExtent (R);
Dec (R.B.X);
R.A.X := R.B.X - 9;
R.A.Y := R.B.Y - 1;
Memory_Indicator := New (Gadgets.PHeapView, Init (R));
Insert (Memory_Indicator);
end; { T_EditDemo.Insert_Memory_Indicator }
{ MEMWIN - Stop. } { Function responsible for inserting heap view on status line. }
{ ---------------------------------------------------------------------------}
{ DESKTOP - Start. }
function T_EditDemo.Load_Desktop : Boolean;
{ ---------------------------------------------------------------- }
{ }
{ Since the safety pool is only large enough to guarantee that }
{ allocating a window will not run out of memory, loading the }
{ entire desktop without checking LowMemory could cause a heap }
{ error. This means that each window should be read individually, }
{ instead of using Desktop's Load. }
{ }
{ ---------------------------------------------------------------- }
VAR
S : PStream;
begin
Load_Desktop := False;
if Desktop_Name = '' then
Exit;
S := New (Objects.PBufStream, Init (Desktop_Name, Objects.stOpenRead, 1024));
{ ------------------------------------------------------------- }
{ }
{ If not enough memory, then tell user. If the desktop file }
{ does not exist, or could not be read, tell the user about it. }
{ }
{ ------------------------------------------------------------- }
if Memory.LowMemory then
App.Application^.OutOfMemory
else
if S^.Status <> Objects.stOk then
MsgBox.MessageBox (^C'Could not open desktop file ' + #13 + #13
+ ^C + Desktop_Name, nil, MsgBox.mfOkButton + MsgBox.mfError)
else
begin
{ --------------------------------------------------------------- }
{ }
{ Go read the desktop file and insert all views into the desktop. }
{ Tell the user if we encounter any sort of a problem. }
{ }
{ --------------------------------------------------------------- }
DesktopReadViews (S^);
if S^.Status <> Objects.stOk then
MsgBox.MessageBox (^C'Error reading desktop file', nil,
MsgBox.mfOkButton + MsgBox.mfError)
else
Load_Desktop := True;
end;
Dispose (S, Done);
end; { T_EditDemo.Load_Desktop }
{ DESKTOP - Stop. } { "Driver" code to load the desktop. }
{ ------------------------------------------------------------------------ }
procedure T_EditDemo.OutOfMemory;
{ --------------------------------------------------------- }
{ }
{ This procedure is an overload method for the application. }
{ It brings up a message box stating "Not enough memory }
{ available" whenever the user tries to open an application }
{ which can't fit into its place in the desktop. }
{ }
{ --------------------------------------------------------- }
begin
MsgBox.MessageBox (^C'Not enough memory available.',
nil, MsgBox.mfError + Msgbox.mfOkButton);
end; { T_EditDemo.OutOfMemory }
{ -------------------------------------------------------------------------- }
{ DESKTOP - Start. }
function T_EditDemo.Save_Desktop : Boolean;
{ -------------------------------------------------------------- }
{ }
{ This function will save the current desktop to a file on disk. }
{ }
{ -------------------------------------------------------------- }
VAR
S : Objects.PStream;
F : File;
begin
Save_Desktop := False;
if Desktop_Name = '' then
Exit;
S := New (Objects.PBufStream, Init (Desktop_Name, Objects.stCreate, 1024));
{ ------------------------------------------------------------------ }
{ }
{ If we have enough memory, and there's no problem with the stream }
{ deallocate the editor clipboard, write all the desktop views to }
{ desktop file on disk, and then reallocate the editor clipboard. }
{ The clipboard MUST be deallocated and reallocated or the desktop }
{ file will start filling with duplicate information with each save. }
{ }
{ ------------------------------------------------------------------ }
if not Memory.LowMemory and (S^.Status = Objects.stOk) then
begin
EditPkg.Deallocate_The_Clipboard;
DesktopWriteViews (S^);
EditPkg.Initialize_The_Clipboard;
{ ----------------------------------------------------------------- }
{ }
{ Tell the user if there was any sort of error in writing the file. }
{ }
{ ----------------------------------------------------------------- }
if S^.Status <> Objects.stOk then
begin
MsgBox.MessageBox (^C'Could not create ' + Desktop_Name, nil,
MsgBox.mfOkButton + MsgBox.mfError);
Dispose (S, Done);
Assign (F, Desktop_Name);
Erase (F);
Exit;
end;
end;
Dispose (S, Done);
Save_Desktop := True;
end; { T_EditDemo.Save_Desktop }
{ DESKTOP - Stop. } { "Driver" code to store the desktop. }
{ ------------------------------------------------------------------------ }
{ SCRNSZ - Start. }
procedure T_EditDemo.Toggle_Video_Mode;
{ --------------------------------------------------------------------- }
{ }
{ This procedure toggles the video mode between normal and 43/50 lines. }
{ Each time the video mode is toggled, the memory indicator view must }
{ be deallocated and re-inserted into the desktop. Failure to do so }
{ will result in the memory indicator view showing up in the middle of }
{ the screen in 43/50 line mode -- not pretty! }
{ }
{ --------------------------------------------------------------------- }
begin
if Drivers.HiresScreen = True then
begin
if Memory_Indicator <> nil then
Dispose (Memory_Indicator, Done);
App.TApplication.SetScreenMode (Drivers.ScreenMode XOR Drivers.smFont8x8);
Current_Screen_Mode := Drivers.ScreenMode;
Insert_Memory_Indicator;
end;
end; { T_EditDemo.Toggle_Video_Mode }
{ SCRNSZ - Stop. } { Procedure responsible for toggling normal and 43/50 line mode. }
{ ---------------------------------------------------------------------------}
{ }
{ MAIN PROCEDURE }
{ }
{ ---------------------------------------------------------------------------}
VAR
Demo_Application : T_EditDemo; { The demo program desktop. }
begin
Demo_Application.Init; { Initialize the system. }
Demo_Application.Run; { Run the system. }
Demo_Application.Done; { Deallocate the system. }
writeln ('End program.');
end. { Program EditDemo }
